home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / TURB_VIS / TVDMX / TVDMXCOL.PAS < prev    next >
Pascal/Delphi Source File  |  1994-06-20  |  15KB  |  571 lines
  1.  
  2. {■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■}
  3. {                            }
  4. {    tvDMXCOL  --Collection Data Editing Unit    }
  5. {    tvDMX      --data editing project        }
  6. {                            }
  7. {    Copyright (c) 1992,94    Randolph Beck        }
  8. {                P.O. Box  56-0487    }
  9. {                Orlando, FL 32856    }
  10. {                CIS:  72361,753        }
  11. {                            }
  12. {■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■}
  13.  
  14. Unit tvDMXCOL;
  15.  
  16. {$B-,O+,R-,V-,X+ }
  17.  
  18. interface
  19.  
  20. uses
  21.     Objects, Drivers, Memory, Views, App, MsgBox,
  22.     RSet, DmxGizma, tvDMX, StdDMX;
  23.  
  24. type
  25.     PDmxCollectView    = ^TDmxCollectView;
  26.     PDmxCollector    = ^TDmxCollector;
  27.     PDmxCollectViewWin    = ^TDmxCollectViewWin;
  28.     PDmxCollectorWin    = ^TDmxCollectorWin;
  29.  
  30.  
  31.     TDmxCollectView    =  OBJECT(TDmxScroller)
  32.       constructor Init(ATemplate : string;  var AData;
  33.             var Bounds : TRect;  ALabels : PView;
  34.             AHScrollBar,AVScrollBar : PScrollBar);
  35.       function    DataAt(RecNum : integer) : pointer;  VIRTUAL;
  36.       procedure InitData(var AData );  VIRTUAL;
  37.       function    RecordLimit : longint;    VIRTUAL;
  38.       procedure SetState(AState : word; Enable : boolean);  VIRTUAL;
  39.     end;
  40.  
  41.  
  42.     TDmxCollector    =  OBJECT(TDmxEditor)
  43.     Expandable    : boolean;
  44.     NewDataRec    : pointer;
  45.     MaxCount    : integer;
  46.     MemWarning    : boolean;
  47.       function    DataAt(RecNum : integer) : pointer;  VIRTUAL;
  48.       procedure DoneData;  VIRTUAL;
  49.       procedure EvaluateRecord;  VIRTUAL;
  50.       procedure HandleEvent(var Event : TEvent);  VIRTUAL;
  51.       procedure InitData(var AData );  VIRTUAL;
  52.       procedure InitNewDataRec;
  53.       procedure LoadStruct(var S : TStream);  VIRTUAL;
  54.       function    RecordLimit : longint;    VIRTUAL;
  55.       procedure SetState(AState : word; Enable : boolean);  VIRTUAL;
  56.       procedure SetupRecord;  VIRTUAL;
  57.       procedure StoreStruct(var S : TStream);  VIRTUAL;
  58.       function    Valid(Command : word) : boolean;  VIRTUAL;
  59.       procedure ZeroizeRecord;    VIRTUAL;
  60.     end;
  61.  
  62.  
  63.     TDmxCollectViewWin    =  OBJECT(TDmxViewer)
  64.       constructor Init(var Bounds : TRect;  ATitle : TTitleStr;
  65.             ANumber : integer;  ATemplate : string;
  66.             ACollection : PCollection;  var ALabels : string);
  67.       procedure InitDMX(ATemplate  : string;  var AData;
  68.              ALabels, ARecInd  : PDmxLink;
  69.              BSize    : longint);  VIRTUAL;
  70.     end;
  71.  
  72.  
  73.     TDmxCollectorWin    =  OBJECT(TDmxWindow)
  74.       constructor Init(var Bounds : TRect;
  75.             ATitle      : TTitleStr;    ANumber  : integer;
  76.             ATemplate : string;  ACollection : PCollection;
  77.             BSize      : integer; var ALabels : string; IndLen : integer);
  78.       procedure InitDMX(ATemplate  : string;  var AData;
  79.              ALabels, ARecInd  : PDmxLink;
  80.              BSize    : longint);  VIRTUAL;
  81.     end;
  82.  
  83.  
  84.   function  fldObjectVMT(Obj : PObject) : string;
  85.     { template prefix to generate a VMT identifier
  86.       for collections of TObject derivatives
  87.      }
  88.  
  89.   procedure ResetCollection(Collection : PCollection);
  90.     { adjust the size of the database }
  91.  
  92.  
  93.   procedure RegisterTVDMXCOL;
  94.  
  95.  
  96. const
  97.     RDmxCollectView    :  TStreamRec =(
  98.     ObjType:   rnDmxCollectView;
  99.     VmtLink:   ofs(TypeOf(TDmxCollectView)^);
  100.     Load:       @TDmxCollectView.Load;
  101.     Store:       @TDmxCollectView.Store
  102.       );
  103.  
  104.     RDmxCollector    :  TStreamRec =(
  105.     ObjType:   rnDmxCollector;
  106.     VmtLink:   ofs(TypeOf(TDmxCollector)^);
  107.     Load:       @TDmxCollector.Load;
  108.     Store:       @TDmxCollector.Store
  109.       );
  110.  
  111.     RDmxCollectViewWin    :  TStreamRec =(
  112.     ObjType:   rnDmxCollectViewWin;
  113.     VmtLink:   ofs(TypeOf(TDmxCollectViewWin)^);
  114.     Load:       @TDmxCollectViewWin.Load;
  115.     Store:       @TDmxCollectViewWin.Store
  116.       );
  117.  
  118.     RDmxCollectorWin    :  TStreamRec =(
  119.     ObjType:   rnDmxCollectorWin;
  120.     VmtLink:   ofs(TypeOf(TDmxCollectorWin)^);
  121.     Load:       @TDmxCollectorWin.Load;
  122.     Store:       @TDmxCollectorWin.Store
  123.       );
  124.  
  125.  
  126. implementation
  127.  
  128.   { ══════════════════════════════════════════════════════════════════════ }
  129.  
  130.  
  131. function  fldObjectVMT(Obj : PObject) : string;
  132. begin
  133.   fldObjectVMT := ^H^F^F'c'^V + pchar(Obj)^ + #0^H^F^F'c'^V + pstring(Obj)^[1] + #0;
  134.   Dispose(Obj, Done);
  135. end;
  136.  
  137.  
  138. procedure ResetCollection(Collection : PCollection);
  139. { adjust the size of the database }
  140. begin
  141.   Repeat
  142.   Until (Message(DeskTop, evBroadcast, cmDMX_Reset, Collection) = nil)
  143.      or (Collection^.Count > 0);
  144.   Message(DeskTop, evCommand, cmDMX_Reset, Collection);
  145. end;
  146.  
  147.  
  148.   { ══ TDmxCollectView ═══════════════════════════════════════════════════ }
  149.  
  150.  
  151. constructor TDmxCollectView.Init(ATemplate    : string;  var AData;
  152.                   var Bounds    : TRect;
  153.                   ALabels    : PView;
  154.                   AHScrollBar,AVScrollBar : PScrollBar);
  155. begin
  156.   TDmxScroller.Init(ATemplate, AData, 0, Bounds, ALabels, AHScrollBar, AVScrollBar);
  157. end;
  158.  
  159.  
  160. function  TDmxCollectView.DataAt(RecNum : integer) : pointer;
  161. begin
  162.   If (PCollection(WorkingData)^.Count <= RecNum) then
  163.     DataAt := nil
  164.    else
  165.     DataAt := PCollection(WorkingData)^.At(RecNum);
  166. end;
  167.  
  168.  
  169. procedure TDmxCollectView.InitData(var AData );
  170. var  RecSize,RecCount    : longint;
  171. begin
  172.   TDmxScroller.InitData(AData);
  173.   RecSize  := RecordSize;
  174.   RecCount := PCollection(WorkingData)^.Count;
  175.   DataBlockSize := RecSize * RecCount;
  176. end;
  177.  
  178.  
  179. function  TDmxCollectView.RecordLimit : longint;
  180. begin
  181.   RecordLimit := PCollection(WorkingData)^.Count
  182. end;
  183.  
  184.  
  185. procedure TDmxCollectView.SetState(AState : word; Enable : boolean);
  186. var  RecSize,RecCount    : longint;
  187. begin
  188.   If Enable and (AState = sfFocused) then
  189.     begin
  190.     RecSize  := RecordSize;
  191.     RecCount := PCollection(WorkingData)^.Count;
  192.     DataBlockSize := RecSize * RecCount;
  193.     end;
  194.   TDmxScroller.SetState(AState, Enable);
  195. end;
  196.  
  197.  
  198.   { ══ TDmxCollector ═════════════════════════════════════════════════════ }
  199.  
  200.  
  201. function  TDmxCollector.DataAt(RecNum : integer) : pointer;
  202. { this method is called whenever it must retrieve a record,
  203.   whether it is for display purposes or for editing }
  204. begin
  205.   If (PCollection(WorkingData)^.Count <= RecNum) then
  206.     DataAt  := NewDataRec
  207.    else
  208.     DataAt  := PCollection(WorkingData)^.At(RecNum);
  209. end;
  210.  
  211.  
  212. procedure TDmxCollector.DoneData;
  213. { this method is called during termination }
  214. begin
  215.   TDmxEditor.DoneData;
  216.   If (NewDataRec <> nil) then FreeMem(NewDataRec, RecordSize);
  217. end;
  218.  
  219.  
  220. procedure TDmxCollector.EvaluateRecord;
  221. { called after each record is edited }
  222. var  P : pointer;
  223. begin
  224.   TDmxEditor.EvaluateRecord;
  225.   If RecordAltered then
  226.     begin
  227.     { If this is an old record, then we can assume that this is the
  228.       one we were editing.  Otherwise, we need to make a new one. }
  229.     If (PCollection(WorkingData)^.Count <= CurrentRecord) then
  230.       begin
  231.       { place the record into the collection }
  232.       P := NewDataRec;
  233.       PCollection(WorkingData)^.Insert(NewDataRec);
  234.  
  235.       { create a new record for NewDataRec }
  236.       GetMem(NewDataRec, RecordSize);
  237.       RecordData := NewDataRec;
  238.       TDmxEditor.ZeroizeRecord;
  239.       RecordData := P;
  240.       If ((MaxCount = 0) or (PCollection(WorkingData)^.Count < MaxCount))
  241.      and (CurrentRecord < MaxCollectionSize) then
  242.     begin
  243.     If ((MemAvail shr 4) > LowMemSize) then
  244.       begin
  245.       { increase the size of the database }
  246.       DataBlockSize := DataBlockSize + RecordSize;
  247.       SetLimit(Limit.X, DataBlockSize div RecordSize);
  248.       Expandable := TRUE;
  249.       end
  250.      else
  251.       begin
  252.       Expandable := FALSE;
  253.       If not MemWarning then
  254.         begin
  255.         MessageBox('Too little memory to expand collection.', nil, mfError + mfOKCancel);
  256.         MemWarning := TRUE;
  257.         end;
  258.       end;
  259.     end;
  260.       end;
  261.     end;
  262. end;
  263.  
  264.  
  265. procedure TDmxCollector.HandleEvent(var Event : TEvent);
  266. var  L : longint;
  267.     procedure InsertRec;
  268.     var  P: pointer;
  269.     begin
  270.       EvaluateField;
  271.       EvaluateRecord;
  272.       If ((MaxCount = 0) or (PCollection(WorkingData)^.Count < MaxCount))
  273.      and (Limit.Y < MaxCollectionSize) then
  274.     begin
  275.     If ((MemAvail shr 4) > LowMemSize) then
  276.       begin
  277.       GetMem(RecordData, RecordSize);
  278.       TDmxEditor.ZeroizeRecord;  { this initializes the new record }
  279.       PCollection(WorkingData)^.AtInsert(CurrentRecord, RecordData);
  280.       DataBlockSize := DataBlockSize + RecordSize;
  281.       SetLimit(Limit.X, Limit.Y+1);
  282.       DrawView;
  283.       Expandable := TRUE;
  284.       end
  285.      else
  286.       begin
  287.       Expandable := FALSE;
  288.       If not MemWarning then
  289.         begin
  290.         MessageBox('Too little memory to expand collection.', nil, mfError + mfOKCancel);
  291.         MemWarning := TRUE;
  292.         end;
  293.       end;
  294.     end;
  295.       SetupRecord;
  296.       SetupField;
  297.     end;
  298. begin
  299.   If (Event.What and evMessage <> 0) and (Event.Command = cmDMX_Reset) and
  300.      (Event.InfoPtr = WorkingData) then
  301.     begin
  302.     DataBlockSize := RecordSize;
  303.     L := PCollection(WorkingData)^.Count;
  304.     DataBlockSize := DataBlockSize * L;
  305.     If (MaxCount = 0) or (PCollection(WorkingData)^.Count < MaxCount) then
  306.       DataBlockSize := DataBlockSize + RecordSize;
  307.     If (DataBlockSize <= 0) and (Owner <> nil) and
  308.        ((State and sfFocused = 0) or (Event.What = evCommand)) then
  309.       begin
  310.       Event.What := evCommand;
  311.       Event.Command := cmClose;
  312.       Event.InfoPtr := Owner;
  313.       end
  314.      else
  315.       begin
  316.       If RecordSelected then
  317.     begin
  318.     FieldAltered  := FALSE;
  319.     RecordAltered := FALSE;
  320.     EvaluateField;
  321.     EvaluateRecord;
  322.     If (CurrentRecord >= (DataBlockSize div RecordSize)) and
  323.        (DataBlockSize > 0) then
  324.       CurrentRecord := pred(DataBlockSize div RecordSize);
  325.     SetupRecord;
  326.     SetupField;
  327.     end;
  328.       SetLimit(Limit.X, DataBlockSize div RecordSize);
  329.       DrawView;
  330.       If (Event.What = evCommand) then ClearEvent(Event);
  331.       end;
  332.     end
  333.    else
  334.     begin
  335.     TDmxEditor.HandleEvent(Event);
  336.     If (Event.What = evCommand) and (Event.Command = cmDMX_InsertRec) then
  337.       InsertRec
  338.     else
  339.     If (Event.What = evKeyDown) and (Event.Command = kbCtrlN) then
  340.       Message(Application, evCommand, cmDMX_InsertRec, @Self)
  341.     else
  342.       Exit;
  343.     ClearEvent(Event);
  344.     end;
  345. end;
  346.  
  347.  
  348. procedure TDmxCollector.InitData(var AData );
  349. { this method is called during initialization }
  350. var  RecSize,RecCount    : longint;
  351. begin
  352.   TDmxEditor.InitData(AData);
  353.  
  354.   { Note that the given database size is used for max record count. }
  355.   Move(DataBlockSize, MaxCount, 2);
  356.  
  357.   RecSize  := RecordSize;
  358.   RecCount := PCollection(WorkingData)^.Count;
  359.   DataBlockSize := RecSize * RecCount;
  360.   If (MaxCount = 0) or (RecCount < MaxCount) then
  361.     begin
  362.     DataBlockSize := DataBlockSize + RecordSize;
  363.     Expandable := TRUE;
  364.     end;
  365.  
  366.   InitNewDataRec;
  367. end;
  368.  
  369.  
  370. procedure TDmxCollector.InitNewDataRec;
  371. { initialize a temporary data object for new records }
  372. begin
  373.   If (RecordSize > 0) then
  374.     begin
  375.     GetMem(NewDataRec, RecordSize);
  376.     RecordData        := NewDataRec;
  377.     TDmxEditor.ZeroizeRecord;
  378.     RecordAltered    := FALSE;
  379.     FieldAltered    := FALSE;
  380.     end
  381.    else
  382.     NewDataRec    := nil;
  383. end;
  384.  
  385.  
  386. procedure TDmxCollector.LoadStruct(var S : TStream);
  387. begin
  388.   TDmxEditor.LoadStruct(S);
  389.   S.Read(MaxCount, sizeof(MaxCount));
  390.   InitNewDataRec;
  391. end;
  392.  
  393.  
  394. function  TDmxCollector.RecordLimit : longint;
  395. begin
  396.   RecordLimit := PCollection(WorkingData)^.Count
  397. end;
  398.  
  399.  
  400. procedure TDmxCollector.SetState(AState : word; Enable : boolean);
  401. { resets the DataBlockSize if the collection's limit has changed }
  402. var  RecSize,RecCount    : longint;
  403. begin
  404.   RecSize  := RecordSize;
  405.   RecCount := PCollection(WorkingData)^.Count;
  406.   If Enable and (AState = sfFocused) and
  407.     (DataBlockSize <> RecSize * succ(RecCount)) then
  408.     begin
  409.     DataBlockSize := RecSize * RecCount;
  410.     If (MaxCount = 0) or (RecCount < MaxCount) then
  411.       begin
  412.       DataBlockSize := DataBlockSize + RecordSize;
  413.       Expandable := TRUE;
  414.       end
  415.      else
  416.       Expandable := FALSE;
  417.     end;
  418.   TDmxEditor.SetState(AState, Enable);
  419. end;
  420.  
  421.  
  422. procedure TDmxCollector.SetupRecord;
  423. { called before each record is edited }
  424. var  P       : pointer;
  425.      DA,JA : boolean;
  426. begin
  427.   TDmxEditor.SetupRecord;
  428.   If (PCollection(WorkingData)^.Count <= CurrentRecord) then
  429.     begin
  430.     DA := DataAltered;
  431.     JA := JustAltered;
  432.     TDmxEditor.ZeroizeRecord;
  433.     RecordAltered := FALSE;
  434.     FieldAltered := FALSE;
  435.     DataAltered := DA;
  436.     JustAltered := JA;
  437.     Expandable    := TRUE;
  438.     end;
  439. end;
  440.  
  441.  
  442. procedure TDmxCollector.StoreStruct(var S : TStream);
  443. begin
  444.   TDmxEditor.StoreStruct(S);
  445.   S.Write(MaxCount, sizeof(MaxCount));
  446. end;
  447.  
  448.  
  449. function  TDmxCollector.Valid(Command : word) : boolean;
  450. var  V : boolean;
  451. begin
  452.   V := TDmxEditor.Valid(Command);
  453.   If V and (Command = cmValid) and
  454.      ((WorkingData = nil) or (DataBlockSize < RecordSize) or (RecordSize <= 0)) then
  455.     begin
  456.     MessageBox('No data available.', nil, mfError or mfOKButton);
  457.     Valid := FALSE;
  458.     end
  459.   else
  460.   If V and (Command = cmDMX_ZeroizeRecord) and (not RecordSelected) then
  461.     Valid := FALSE
  462.   else
  463.     Valid := V;
  464. end;
  465.  
  466.  
  467. procedure TDmxCollector.ZeroizeRecord;
  468. var  RS : boolean;
  469.      E    : TEvent;
  470. begin
  471.   If Locked then Exit;
  472.   RS := RecordSelected;
  473.   If RS then
  474.     begin
  475.     EvaluateField;
  476.     EvaluateRecord;
  477.     end;
  478.   If (PCollection(WorkingData)^.Count > CurrentRecord) then
  479.     begin
  480.     PCollection(WorkingData)^.AtFree(CurrentRecord);
  481.     { adjust the size of the database }
  482.     Repeat
  483.     Until (Message(DeskTop, evBroadcast, cmDMX_Reset, WorkingData) = nil)
  484.        or (DataBlockSize > 0);
  485.     If (DataBlockSize = 0) then
  486.       begin
  487.       E.What := evCommand;
  488.       E.Command := cmClose;
  489.       E.InfoPtr := Owner;
  490.       PutEvent(E);
  491.       end;
  492.     end;
  493.   If RS then
  494.     begin
  495.     SetupRecord;
  496.     SetupField;
  497.     end;
  498. end;
  499.  
  500.  
  501.   { ══ TDmxCollectViewWin ════════════════════════════════════════════════ }
  502.  
  503.  
  504. constructor TDmxCollectViewWin.Init(var Bounds    : TRect;
  505.         ATitle      : TTitleStr;    ANumber  : integer;
  506.         ATemplate : string;  ACollection : PCollection;
  507.         var ALabels : string);
  508. begin
  509.   TDmxViewer.Init(Bounds, ATitle, ANumber, ATemplate,
  510.            ACollection^, 0, ALabels);
  511. end;
  512.  
  513.  
  514. procedure TDmxCollectViewWin.InitDMX(ATemplate    : string;  var AData;
  515.                 ALabels, ARecInd : PDmxLink;
  516.                 BSize  : longint);
  517. var  R    : TRect;
  518. begin
  519.   GetExtent(R);
  520.   R.Grow(-1,-1);
  521.   If ALabels <> nil then Inc(R.A.Y, ALabels^.Size.Y);
  522.   Insert(New(PDmxCollectView, Init(ATemplate, AData, R, ALabels,
  523.         StandardScrollBar(sbHorizontal),
  524.         StandardScrollBar(sbVertical))));
  525. end;
  526.  
  527.  
  528.   { ══ TDmxCollectorWin ══════════════════════════════════════════════════ }
  529.  
  530.  
  531. constructor TDmxCollectorWin.Init(var Bounds    : TRect;
  532.         ATitle      : TTitleStr;    ANumber  : integer;
  533.         ATemplate : string;  ACollection : PCollection;
  534.         BSize      : integer; var ALabels : string; IndLen : integer);
  535. begin
  536.   TDmxWindow.Init(Bounds, ATitle, ANumber, ATemplate,
  537.           ACollection^, BSize, ALabels, IndLen);
  538. end;
  539.  
  540.  
  541. procedure TDmxCollectorWin.InitDMX(ATemplate  : string;  var AData;
  542.             ALabels, ARecInd : PDmxLink;  BSize  : longint);
  543. var  R    : TRect;
  544. begin
  545.   GetExtent(R);
  546.   R.Grow(-1,-1);
  547.   If ALabels <> nil then Inc(R.A.Y, ALabels^.Size.Y);
  548.   Insert(New(PDmxCollector, Init(ATemplate, AData, BSize, R,
  549.         ALabels, ARecInd,
  550.         StandardScrollBar(sbHorizontal),
  551.         StandardScrollBar(sbVertical))));
  552. end;
  553.  
  554.  
  555.   { ══════════════════════════════════════════════════════════════════════ }
  556.  
  557.  
  558. procedure RegisterTVDMXCOL;
  559. begin
  560.   RegisterType(RDmxCollectView);
  561.   RegisterType(RDmxCollector);
  562.   RegisterType(RDmxCollectViewWin);
  563.   RegisterType(RDmxCollectorWin);
  564. end;
  565.  
  566.  
  567.   { ══════════════════════════════════════════════════════════════════════ }
  568.  
  569.  
  570. End.
  571.